home *** CD-ROM | disk | FTP | other *** search
- unit WebMod;
- interface
- uses
- Windows, Messages, SysUtils, Classes, HTTPApp;
-
- type
- TWebModule1 = class(TWebModule)
- procedure WebModule1WebActionItem3Action(Sender: TObject;
- Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- WebModule1: TWebModule1;
-
- implementation
- uses
- Base64;
- {$R *.DFM}
-
- procedure TWebModule1.WebModule1WebActionItem3Action(Sender: TObject;
- Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
- var
- Auth: String;
- begin
- Auth := Request.Authorization;
- if Pos('Basic ',Auth) = 1 then Delete(Auth,1,6);
- Auth := UnBase64(Auth);
- if Pos('bswart',Auth) = 0 then
- begin
- Response.StatusCode := 401;
- Response.WWWAuthenticate := 'Basic';
- Response.Realm := '/DrBob';
- Response.SendResponse;
- end
- else
- begin
- Response.Content := 'Welcome: ['+Request.Authorization+']=['+Auth+'])'
- end
- end;
-
- end.
-
-